Libris Britannia 4/science library(b).zip/science library(b)/HAMRADIO/LOGBOOK.ZIP/DXCC.PRG

Text File | 1987-07-17 | 7KB | 214 lines

*DXCC.PRG CALLED FROM LOGBOOK/LOGAWARD VERSION 860626
* BY JOE KASSER G3ZCZ (c) 1985,1986

DO WHILE task <> '*'
   ERASE
   @ 3,11 SAY  'G3ZCZ DXCC AWARD PACKAGE Version 1.7'
   @ 5,1  SAY 'Default DXCC database is '
   @ 5,26 SAY dxcc
   @  6,1 SAY 'Default LOG database is'
   @ 6,26 SAY logbook
   @  9,1 SAY 'UPDATE DXCC RECORDS  (Automatic)            U'
   @ 10,1 SAY 'UPDATE DXCC RECORDS  (Manual)               M'
   @ 11,1 SAY 'CREATE A NEW DXCC DATABASE                  C'
   @ 12,1 SAY 'CREATE 5BDXCC RECORDS                       5'
   @ 13,1 SAY 'PRINT DXCC RECORDS                          P'
   @ 14,1 SAY 'ADD PREFIXES TO A DXCC DATABASE             A'
   @ 15,1 SAY 'CHANGE DXCC DATABASE                        D'
   @ 16,1 SAY 'EDIT PREFIXES IN DXCC RECORD FILE           E'
   @ 17,1 SAY 'CHANGE LOGBOOK                              L'
   @ 18,1 SAY 'UPDATE SINGLE BAND DXCC RECORD (Automatic)  S'
   @ 19,1 SAY 'DISPLAY DATA FOR A PREFIX/COUNTRY           X'
   @ 20,1 SAY 'DISPLAY FILES ON DISK DRIVE                 F'
   @ 21,1 SAY 'QUIT THIS MENU                              *'
   @ 22,1 SAY 'QRU'
   @ 22,5 GET task
   READ

   IF task = 'F'
      ERASE
      ACCEPT 'WHICH DRIVE ' TO diskdrive
      STORE diskdrive + ':' TO diskdrive
      DISPLAY FILES ON &diskdrive
      RELEASE diskdrive
      WAIT
   ENDIF

   IF task = 'D'
      @ 22,1 SAY 'Which DXCC file '
      @ 22,18 GET dxcc
      READ
      IF FILE(dxcc+'.DBF')
         @ 22,1 SAY '                          '
      ELSE
         ? 'WARNING, file',dxcc,' does not exist on default disk'
         WAIT
      ENDIF
   ENDIF

   IF task = 'C'
      STORE 'DXCC' TO dxcc
      IF FILE(dxcc+'.DBF')
         * DXCCCLR 850923 CREATES A CLEAR DXCC RECORD FILE
         STORE '           ' TO blank
         ACCEPT 'What is the name of the new DXCC file ? ' TO dxcc
         ?
         IF FILE (dxcc+'.DBF')
            ? 'ERROR ',dxcc,' ALREADY EXISTS'
         ELSE
            use dxcc
            ? 'CREATING blankdx FILE AND COPYING DATA'
            SET TALK ON
            COPY TO &dxcc
            SET TALK OFF
            USE &dxcc
            ? 'MAKING SURE NEW FILE IS BLANK'
            DO WHILE .NOT. EOF()
               ? px,px1,country
               REPLACE dcall WITH blank
               REPLACE ddate WITH blank
               REPLACE dtime WITH blank
               REPLACE dband WITH blank
               REPLACE dmode WITH blank
               REPLACE dstate WITH blank
               SKIP
            ENDDO
            ?
            ? 'NEW BLANK DXCC FILE CREATED'
            RELEASE blank
            USE
         ENDIF
      ELSE
         ? 'ERROR, Blank file DXCC.DBF does not exist on default disk'
         WAIT
      ENDIF
   ENDIF

   IF task = 'L'
      @ 22,1 SAY 'Which Log file '
      @ 22,15 GET logbook
      READ
      IF FILE (logbook+'.DBF')
         @ 22,1 SAY '                          '
      ELSE
         @ 22,1 SAY ' '
         ? 'ERROR, ',logbook, 'IS NOT PRESENT ON DRIVE'
         WAIT
      ENDIF
   ENDIF

   IF task = '*'
      * DO NOTHING
   ELSE
      IF FILE (dxcc+'.DBF')
         *FILE EXISTS
         DO CASE

         CASE task = 'S'
            DO DXCCSB

         CASE task = 'E'
            DO DXCCPXED

         CASE task = '5'
            DO DXCC5B

         CASE task = 'A'
            DO DXCCPXAD

         CASE task = 'P'
            ERASE
            STORE ' ' TO choice
            @ 5,1 SAY ' '
            ACCEPT 'All PXs,Worked/QSL-d,or QSL-d (P,W,Q) ' TO choice
            @ 10,1 SAY ' '
            IF CHOICE = 'P' .OR. CHOICE = 'W' .OR. CHOICE = 'Q'
               STORE ' ' TO pf
               ACCEPT 'Do you want hard copy (Y/N) ?' TO pf
               DO DXCCPRNT
               RELEASE pf
            ELSE
               ? CHOICE,' IS NOT VALID, ENTER  P or W  or Q only please '
            ENDIF
            WAIT

         CASE task = 'U'
            IF logbook = '      '
               @ 23,1  SAY 'OPEN A LOGBOOK FIRST'
               WAIT
            ELSE
               IF FILE (logbook+'.DBF')
                  DO DXCCUPDT
               ELSE
                  @ 23,1 SAY 'ERROR, NO LOGBOOK PRESENT ON DEFAULT DRIVE'
                  WAIT
               ENDIF
            ENDIF

         CASE task = 'M'
            IF logbook = '      '
               @ 23,1  SAY 'OPEN A LOGBOOK FIRST'
               WAIT
            ELSE
               IF FILE (logbook+'.DBF')
                  DO DXCCMAN
               ELSE
                  @ 23,1 SAY 'ERROR, NO LOGBOOK PRESENT ON DEFAULT DRIVE'
                  WAIT
               ENDIF
            ENDIF

        CASE task = 'X'
             ERASE
             STORE '    ' TO epx
             USE &dxcc
             GOTO BOTTOM
             STORE # TO lastpx
             DO WHILE epx <> '*'
                @ 8,1 SAY ' CURRENT DXCC FILE IS'
                @ 8,25 SAY dxcc
                @ 10,1 SAY ' Which Prefix  (* to terminate) ? '
                @ 10,35 GET epx
                READ
                STORE T TO fpx
                IF epx <> '*'
                   LOCATE FOR px = TRIM(epx)
                   IF # = lastpx
                      *ERROR OR LAST PREFIX
                      LOCATE FOR px1 = TRIM(epx)
                      IF # < lastpx
                         STORE F TO fpx
                      ENDIF
                   ELSE
                      STORE F TO fpx
                   ENDIF
                   IF fpx
                      @ 12,1  SAY 'ERROR  ???'
                      ?? '                                              '
                   ELSE
                      @ 12,1 SAY country
                      @ 12,11 SAY ' '
                      ?? px,px1,dcall,ddate,dtime,dband,dmode,dstate
                   ENDIF
                ENDIF
             ENDDO
             USE
             RELEASE epx,fpx,lastpx

        CASE task = 'L' .OR. task = 'C' .OR. task = 'D' .OR. task = 'F'
           * DO NOTHING, INHIBIT OTHERWISE BRANCH HERE

         OTHERWISE
            ? 'ERROR, DXCC DATABASE does not exist on default disk'
         WAIT
         ENDCASE
      ENDIF
   ENDIF
ENDDO
STORE ' ' TO task
USE
RETURN
   ' TO epx
             USE &dxcc
             GOTO BOTTOM
             ST